home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / X11 / wais / ui / uri-lucid.lisp < prev    next >
Lisp/Scheme  |  1995-05-09  |  3KB  |  96 lines
  1. ;;This file is a Lucid lisp interface for the client functions of WAIS.
  2. ;; I have not used this heavily, so I can not say it is very robust.
  3. ;;
  4. ;; -brewster
  5.  
  6. (in-package 'wais :use '(lisp))
  7.  
  8. (defvar *wais-stream* nil "The stream that talks to the wais process")
  9. (defvar *wais-temp-filename* nil "the temp filename of the file that will be used to store the question and results")
  10. (defvar *verbose* t "prints what it sends to the wais process")
  11. (defmacro comment (&rest ignore) (declare (ignore ignore)) :comment)
  12.  
  13. (defun wais-init (&optional directory)
  14.   "starts a wais process"
  15.   (if (null *wais-temp-filename*)
  16.       (setq *wais-temp-filename*
  17.     (format nil "/tmp/waisq-~d" (get-universal-time)))))
  18.  
  19. (defun wais-search (seed-words database
  20.                    &optional 
  21.                    (source-directory (merge-pathnames (USER-HOMEDIR-PATHNAME) "wais-sources")))
  22.   "runs a wais search and returns a list of document specifiers
  23.    or an error"
  24.   (check-type seed-words string)
  25.   (check-type database string)
  26.   (check-type source-directory (or pathname string))
  27.   (if (not *wais-temp-filename*)
  28.       (wais-init))
  29.  
  30.   (with-open-file (stream *wais-temp-filename* :direction :output)
  31.     (let ((*print-pretty* t))
  32.       (format stream "(:question :version
  33.            2
  34.            :seed-words
  35.            ~s
  36.            :relevant-documents
  37.            ()
  38.            :sources
  39.            ((:source-id :filename ~s))
  40.            :result-documents
  41.            ()
  42.     )~
  43.         " seed-words database)))
  44.  
  45.   (lucid::run-unix-program "/proj/wais/latest/bin/waisq"
  46.                :arguments (list "-f" *wais-temp-filename* "-g"
  47.                         "-s" (namestring source-directory))
  48.                :wait t)
  49.   (with-open-file (stream *wais-temp-filename* :direction :input)
  50.     (second (member :result-documents (read stream)))))
  51.  
  52. (defun wais-retrieve (document-id 
  53.               &optional 
  54.               (source-directory (merge-pathnames (USER-HOMEDIR-PATHNAME) "wais-sources")))
  55.   "retrieves a document or an error"
  56.   (with-open-file (stream *wais-temp-filename* :direction :output)
  57.     (let ((*print-pretty* t) (*print-array* t) (*print-case* :downcase))
  58.       (format stream "(:question :version
  59.            2
  60.            :seed-words
  61.            ()
  62.            :relevant-documents
  63.            ()
  64.            :sources
  65.            ()
  66.            :result-documents
  67.            (~a)
  68.        )~
  69.         " (write-to-string document-id))))
  70.   (let ((stream (lucid::run-unix-program 
  71.           "/proj/wais/latest/bin/waisq"
  72.           :arguments (list "-f" *wais-temp-filename* "-v"
  73.                    "1"
  74.                    "-s" (namestring source-directory))
  75.           :output :stream
  76.           :wait nil)))
  77.     (comment (loop for line = (read-line stream)
  78.            until (equal "done." line)
  79.            ;;do (print line)
  80.            ))
  81.     (with-output-to-string (stream)
  82.       (loop for line = (read-line stream nil :eof)
  83.         until (eq line :eof)
  84.         do (write-line line stream)))))
  85.  
  86. (defun try ()
  87.   "sample use of the wais functions"
  88.   (wais-init )
  89.   (let ((answers (wais-search "dad" "mail-sent.src" "~brewster/wais-sources")))
  90.     (if (null answers)
  91.     (error "no answers were returned")
  92.     (wais-retrieve (first answers) "~brewster/wais-sources"))))
  93.  
  94.  
  95.  
  96.